The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/04/4/DISK0440.ZIP/FILEFIX.PAS

Pascal/Delphi Source File | 1985-05-14 | 7KB | 254 lines

program fix;

 { The following program is designed to 'massage' a text file that terminates }
 { lines a with a CR or CR/LF into a source file for WordPlus by PSI.         }
 {   Written By :                                                             }
 {               Bill Buoy                  5-12-85.                          }
 { This is Version 2.01                                                       }
 { The original was written in PCjr Basic   2-17-85.                          }

 { The process is as follows:
       Open the input file (from the commandline if invoked with with
       filename(s) in the call)

       Open an output file with an extension of .FIX.

       While not end_of_file (input file)

               1. Read a line
                  Append an chr(Endline) marker
                  Find position to start padding
                  Add pad characters to line
                  Replace the '@' symbol with W+ 'open format marker
                  For each character in the line
                      Mask the high order bit to 0.
                  Write the line to the output file.


       Endwhile end_of_file

 }
 {      ********************* Instructions to User **********************

    You may either call the program from DOS and allow the program to request
    the filename to operate on, or from the dr:> prompt, type the input and
    output filenames, separated from the call to FIX by spaces.  This would
    look like this:
                   A>FIX INPUTNAME.EXT OUTPUTNAME.EXT
      where INPUTNAME.TXT and OUTPUTNAME.TXT are not equal

                                or

                   A>FIX INPUTNAME.EXT
      and let FIX supply the output name (INPUTNAME.FIX).

 }
const

        ExtName    ='.FIX';
    Screenwidth    =80;
       Oldfmtmk    ='@';
       Newfmtmk    =$10;
        Endline    =$11;
            Pad    =0;
            Mask   =127;

type
     filestring    =string[14];
            ext    =string[4];
     workstring    =string[255];

var

      Source, Dest:  Text;
       FromName,
            ToName:  filestring;
             Temp,
             Indx,
            Count,
             Repl,
          Padfrom,
               Len:  byte;
              Line:  workstring;
Procedure init;

   Function BuildName(var RootName: filestring; Extension: ext): filestring;

        var
            delpos: integer;
          workname: filestring;

        begin
               delpos:=Pos('.',RootName);

               case delpos of

                    0:     BuildName:=concat (RootName, Extension);

                1..10:     begin
                             workname:=copy (RootName,1,delpos-1);
                             BuildName:=concat (workname, Extension);
                           end;

                 else      begin
                             Writeln('IMPROPER FILENAME');
                             Halt;
                            end;
              end {case delpos};

        end {function buildname};


Begin

     {initialize variables}
       clrscr;
         FromName:='';
           ToName:='';
          Padfrom:=0;
              Len:=0;
             Repl:=0;
             Temp:=0;


     case Paramcount of
          0: begin
                Write('Enter Source File Name (name.ext) ');
                Readln(FromName);
                ToName:=BuildName(FromName,ExtName);
             end;

          1: begin
               FromName:=ParamStr(1);
               ToName:=BuildName(FromName,ExtName);
             end;

          2: begin;
                FromName:=Paramstr(1);
                ToName:=Paramstr(2);
                If FromName=ToName then
                        begin
                                Writeln('Cannot overwrite input file');
                                Halt;
                        end;
             end;

      else   begin
               Writeln('Too Many Parameters on command line.....');
               halt;
             end;
   end; {case}


     if ToName = '' then

             ToName:=BuildName(FromName,ExtName);

     if Pos('.',ToName)=0 then

             ToName:=BuildName(ToName,ExtName);


end {procedure getname};

Procedure access_files;

       Function Open(var fp:text; name: Filestring): boolean;
               begin
                    Assign(fp,Name);
                    If IOresult <> 0 then
                       begin
                            Open := False;
                            close(fp);
                        end
                         else
                             Open := True;
               end { Open };

    begin

         if not open (Source, fromname) then
            begin
                  writeln ('ERROR......file not found');
                 halt;
            end;

         reset (Source);

         if not open (Dest, toname) then
            begin
                 writeln ('ERROR......file could not be opened for output');
                 close (Source);
                 halt;
            end;

         rewrite (Dest);

    end {access files};

Procedure Padline;
    begin
      Line:=concat(Line,chr(Pad));
    end;


Function Maskline(NewLine: workstring):workstring;
    var
       Templine: workstring;

    begin
        Templine:='';
        for Indx:=1 to Len do
         begin
            Temp:=ord(NewLine[Indx]);
            Temp:=Temp AND Mask;
            Templine:=Concat(Templine,Chr(Temp));
         end;
         Maskline:=Templine;
    end;



Procedure process_files;
   begin
          While not eof(Source) do begin

                Readln (Source,Line);
                Line:=Concat(Line,chr(Endline));
                Len:=Length (Line);
                Line:=Maskline(line); {remove special or graphics characters}
                Padfrom:=Len mod Screenwidth;
                Repl:=Pos (Oldfmtmk,Line);
                If Repl <> 0 then
                 begin
                   delete (line,repl,1);
                   insert (chr(Newfmtmk),line,repl);
                 end;
                If Len < 80 then
                      for count:=len+1 to screenwidth do
                       Padline
                Else for count:=padfrom+1 to screenwidth do
                       Padline;
                write (dest,line);
                write (line);
            end;
   end;


BEGIN {main program}
     init;
     writeln('Accessing file ',FromName,' for input.');
     access_files;
     writeln('Reworked file will be ',ToName,'.');
     process_files;
     writeln('Rework completed.');
     close (Source);
     close (Dest);
     writeln (chr(7));
end.